Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/lang_ext/vbawk/utils.bas

BASIC Source File | 1994-08-12 | 5.3 KB | 172 lines

Dim StaticTokenStr As String    'used by StrTok
Dim StaticNdx As Integer        'used by StrTok

Function FileExists (Filename As String) As Integer
    On Error GoTo notthere
    Temp% = FileLen(Filename)
    FileExists = True
    Exit Function
notthere:
    FileExists = False
    Exit Function
End Function

Function gsub (TheString As String, SearchFor As String, Subst As String) As Integer
    If SearchFor = "" Then
        MsgBox "Error in gsub: 0-length search string."
        Exit Function
    End If
    StartAt% = 1
    SearchForLen% = Len(SearchFor)
    SubstLen% = Len(Subst)
    WhereFound% = InStr(StartAt%, TheString, SearchFor, COMPAREMODE)
    While WhereFound%
        Substitute TheString, WhereFound%, SearchForLen%, Subst
        numfound% = numfound% + 1
        StartAt% = WhereFound% + SubstLen%
        WhereFound% = InStr(StartAt%, TheString, SearchFor, COMPAREMODE)
    Wend
    gsub = numfound%
End Function

Function ReverseString (TheStr As String) As String
    For i% = Len(TheStr) To 1 Step -1
        retval$ = retval$ & Mid$(TheStr, i%, 1)
    Next i%
    ReverseString = retval$
End Function

Sub SplitFilePath (ByVal ThePath$, TheDrive$, TheDirs$, TheFile$, TheExtension$)

    'Initialization
    PathNdx% = 1
    ThePathLen% = Len(ThePath$)

    'Is there a drive specifier?
    TheDrive$ = ""
    If InStr(ThePath$, ":") = 2 Then
        TheDrive$ = Left$(ThePath$, 1)
        PathNdx% = 3
    End If
    If PathNdx% > ThePathLen% Then
        'there was nothing but a drive specifier, so quit
        Exit Sub
    End If

    'Are there directories?
    TheDirs$ = ""
    LastSlashNdx% = 0
    SlashNdx% = InStr(PathNdx%, ThePath$, "\")
    While SlashNdx% > 0
        LastSlashNdx% = SlashNdx%
        SlashNdx% = InStr(SlashNdx% + 1, ThePath$, "\")
    Wend
    If LastSlashNdx% <> 0 Then
        TheDirs$ = Mid$(ThePath$, PathNdx%, (LastSlashNdx% - PathNdx%))
        PathNdx% = LastSlashNdx% + 1
    End If
    If PathNdx% > ThePathLen% Then
        'there was nothing after the directories, so quit
        Exit Sub
    End If

    'Get the filename
    TheFile$ = ""
    TheExtension$ = ""
    DotNdx% = InStr(LastSlashNdx% + 1, ThePath$, ".")
    If DotNdx% > 0 Then
        'filename has an extension, so extract it
        TheFile$ = Mid$(ThePath$, PathNdx%, DotNdx% - PathNdx%)
        TheExtension$ = Right$(ThePath$, ThePathLen% - DotNdx%)
    Else
        TheFile$ = Right$(ThePath$, ThePathLen% - LastSlashNdx%)
    End If
End Sub

'STRTOK:
'This routine is closely analagous to the standard 'C' string
'function with the same name.
'
'StrTok parses a string, which is assumed to consist of
'tokens separated by delimiters.  Each Time you call StrTok,
'it returns the next token in the string.
'
'The first time you call it, TokenStr should be the string
'to parse, and Delimiters is the string containing characters
'that delimit the tokens.  For instance, if the tokens are
'separated by either commas or blanks, Delimiters should be
'the following:  " ,"
'
'On succeeding calls to StrTok, TokenStr should be a zero-
'length string ("").  StrTok will remember what TokenStr was.
'However, TokenStr can be anything you want it to be; thus,
'you can look for different delimiters on succeeding calls.
Function StrTok (ByVal TokenStr As String, Delimiters As String) As String
    On Error GoTo finished
    StrTok = ""
    If TokenStr <> "" Then
        'on first call, copy token string to static var
        StaticTokenStr = TokenStr
        StaticNdx = 1
    End If
    'while leftmost chars in StaticTokenStr are delimiters,
    'throw them out.
    While True
        TheChar$ = Mid$(StaticTokenStr, StaticNdx, 1)
        If TheChar$ = "" Then Exit Function
        If InStr(Delimiters, TheChar$) > 0 Then
            StaticNdx = StaticNdx + 1
        Else
            GoTo FoundToken
        End If
    Wend

FoundToken:
    'while succeeding chars in StaticTokenStr are not
    'delimiters, pass them by
    j% = StaticNdx
    While True
        TheChar$ = Mid$(StaticTokenStr, j%, 1)
        If TheChar$ = "" Then GoTo EndOfToken
        If InStr(Delimiters, TheChar$) > 0 Then GoTo EndOfToken
        j% = j% + 1
    Wend

EndOfToken:
    'return the token and update the static token string.
    StrTok = Mid$(StaticTokenStr, StaticNdx, j% - StaticNdx)
    StaticNdx = j%
    Exit Function

finished:
    MsgBox "Error: " & Error$ & " in StrTok"
    Exit Function
End Function

Sub Substitute (TheText$, StartLoc%, TheLen%, Subst$)
    Dim LocalStart As Integer
    Dim LocalLen As Integer
    Dim TheTextLen As Integer

    'sanity checking on start location
    TheTextLen = Len(TheText$)  'for optimization, since Len is referred to often
    If StartLoc% > (TheTextLen + 1) Then
        LocalStart = (TheTextLen + 1)
    Else
        LocalStart = StartLoc%
    End If

    'sanity checking on length
    If TheLen% > (TheTextLen - StartLoc% + 1) Then
        LocalLen = (TheTextLen - StartLoc% + 1)
    Else
        LocalLen = TheLen%
    End If

    'perform the substitution
    LeftPart$ = Left$(TheText$, LocalStart - 1)
    RightPart$ = Right$(TheText$, TheTextLen - LocalStart - LocalLen + 1)
    TheText$ = LeftPart$ & Subst$ & RightPart$
End Sub